home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / TableElems.Mod (.txt) < prev    next >
Oberon Text  |  1994-07-28  |  22KB  |  512 lines
  1. Syntax10.Scn.Fnt
  2. Syntax10i.Scn.Fnt
  3. Syntax10b.Scn.Fnt
  4. Syntax12.Scn.Fnt
  5. MODULE TableElems;    (** CAS 13-May-92 / 28-Sep-93 **)
  6.     IMPORT
  7.         Input, Display, Fonts, Printer, Files, Oberon, Texts, TextFrames, Viewers, MenuViewers, TextPrinter;
  8.     CONST
  9.         Menu = "System.Close  Edit.Search  Edit.Replace All  Edit.Parcs  TableElems.Update ";
  10.         mm = TextFrames.mm; Scale = mm DIV 10; MinW = 3*mm; MinH = 3*mm;
  11.         unit = TextFrames.Unit; Unit = TextPrinter.Unit;
  12.         middleKey = 1;
  13.         TAB = 9X; CR = 0DX;
  14.         MaxCol = 32; MaxRow = 32;
  15.         (*elem.opts set elements*)
  16.             headCol = 0; headRow = 1; colL = 2; rowL = 3; leftL = 4; rightL = 5; topL = 6; botL = 7;
  17.     TYPE
  18.         Row = POINTER TO RowDesc;
  19.         RowDesc = RECORD
  20.             next: Row;
  21.             lsp, dsr: LONGINT;
  22.             pos: ARRAY MaxCol OF LONGINT;
  23.             x, y: ARRAY MaxCol OF LONGINT
  24.         END;
  25.         Elem* = POINTER TO ElemDesc;
  26.         ElemDesc* = RECORD(Texts.ElemDesc)
  27.             def*: Texts.Text;
  28.             parc: TextFrames.Parc;
  29.             opts: SET;
  30.             nofCols, nofRows: INTEGER;
  31.             lw: LONGINT;
  32.             width: ARRAY MaxCol OF LONGINT;
  33.             row: Row    (*rows chained from bottom to top*)
  34.         END;
  35.         Viewer* = POINTER TO ViewerDesc;
  36.         ViewerDesc* = RECORD(MenuViewers.ViewerDesc)
  37.             elem*: Elem
  38.         END;
  39.         W: Texts.Writer;
  40.     PROCEDURE Min (x, y: LONGINT): LONGINT;
  41.     BEGIN
  42.         IF x < y THEN RETURN x ELSE RETURN y END
  43.     END Min;
  44.     PROCEDURE Max (x, y: LONGINT): LONGINT;
  45.     BEGIN
  46.         IF x > y THEN RETURN x ELSE RETURN y END
  47.     END Max;
  48.     PROCEDURE UnmarkMenu (V: Viewers.Viewer);
  49.         VAR R: Texts.Reader; T: Texts.Text; ch: CHAR;
  50.     BEGIN T := V.dsc(TextFrames.Frame).text;
  51.         Texts.OpenReader(R, T, T.len - 1); Texts.Read(R, ch);
  52.         IF ch = "!" THEN Texts.Delete(T, T.len - 1, T.len) END
  53.     END UnmarkMenu;
  54.     (* generate table structure *)
  55.     PROCEDURE Matches (VAR S: Texts.Scanner; key: ARRAY OF CHAR): BOOLEAN;
  56.         VAR i: INTEGER;
  57.     BEGIN i := 0;
  58.         WHILE (S.s[i] # 0X) & (CAP(S.s[i]) = key[i]) DO INC(i) END;
  59.         RETURN (S.class = Texts.Name) & ((key[i] = 0X) OR (i >= 3)) & (S.s[i] = 0X)
  60.     END Matches;
  61.     PROCEDURE Opts (s: ARRAY OF CHAR): SET;
  62.         VAR opts: SET; i: INTEGER; ch: CHAR;
  63.     BEGIN opts := {}; i := 0;
  64.         WHILE s[i] # 0X DO ch := CAP(s[i]);
  65.             IF ch = "H" THEN INCL(opts, headRow)
  66.             ELSIF ch = "V" THEN INCL(opts, headCol)
  67.             ELSIF s[i] = "*" THEN opts := {headRow, headCol}
  68.             END;
  69.             INC(i)
  70.         END;
  71.         RETURN opts
  72.     END Opts;
  73.     PROCEDURE LineOpts (s: ARRAY OF CHAR): SET;
  74.         VAR opts: SET; i: INTEGER; ch: CHAR;
  75.     BEGIN opts := {}; i := 0;
  76.         WHILE s[i] # 0X DO ch := CAP(s[i]);
  77.             IF ch = "H" THEN INCL(opts, rowL)
  78.             ELSIF ch = "V" THEN INCL(opts, colL)
  79.             ELSIF ch = "L" THEN INCL(opts, leftL)
  80.             ELSIF ch = "R" THEN INCL(opts, rightL)
  81.             ELSIF ch = "T" THEN INCL(opts, topL)
  82.             ELSIF ch = "B" THEN INCL(opts, botL)
  83.             ELSIF s[i] = "*" THEN opts := {rowL, colL, leftL, rightL, topL, botL}
  84.             END;
  85.             INC(i)
  86.         END;
  87.         RETURN opts
  88.     END LineOpts;
  89.     PROCEDURE ColOpts (VAR cm: ARRAY OF CHAR; s: ARRAY OF CHAR);
  90.         VAR i: INTEGER; ch: CHAR;
  91.     BEGIN i := 0;
  92.         WHILE (s[i] # 0X) & (i < LEN(cm)) DO ch := CAP(s[i]);
  93.             IF (ch = "C") OR (ch = "L") OR (ch = "N") OR (ch = "R") THEN cm[i] := ch END;
  94.             INC(i)
  95.         END
  96.     END ColOpts;
  97.     PROCEDURE RowOpts (VAR rm: ARRAY OF CHAR; s: ARRAY OF CHAR);
  98.         VAR i: INTEGER; ch: CHAR;
  99.     BEGIN i := 0;
  100.         WHILE (s[i] # 0X) & (i < LEN(rm)) DO ch := CAP(s[i]);
  101.             IF (ch = "B") OR (ch = "C") OR (ch = "L") OR (ch = "T") THEN rm[i] := ch END;
  102.             INC(i)
  103.         END
  104.     END RowOpts;
  105.     PROCEDURE Offset (VAR R: Texts.Reader): LONGINT;
  106.     BEGIN
  107.         IF R.voff = 0 THEN RETURN 0 ELSE RETURN LONG(R.fnt.height) * unit * R.voff DIV 64 END
  108.     END Offset;
  109.     PROCEDURE DispPrepElem (E: Elem; e: Texts.Elem; fnt: Fonts.Font; col: SHORTINT; pos: LONGINT);
  110.         VAR disp: TextFrames.DisplayMsg;
  111.     BEGIN disp.prepare := TRUE;
  112.         disp.fnt := fnt; disp.col := col; disp.pos := pos; disp.indent := 0; e.handle(e, disp)
  113.     END DispPrepElem;
  114.     PROCEDURE PrintPrepElem (E: Elem; e: Texts.Elem; fnt: Fonts.Font; col: SHORTINT; pno: INTEGER; pos: LONGINT);
  115.         VAR print: TextPrinter.PrintMsg;
  116.     BEGIN print.prepare := TRUE;
  117.         print.fnt := fnt; print.col := col; print.pos := pos; print.indent := 0; print.pno := pno; e.handle(e, print)
  118.     END PrintPrepElem;
  119.     PROCEDURE GetElem (E: Elem; e: Texts.Elem;
  120.             fnt: Fonts.Font; col: SHORTINT; pos: LONGINT; VAR dx, x, y, w, h: LONGINT);
  121.     BEGIN x := 0; y := -E.parc.dsr;
  122.         DispPrepElem(E, e, fnt, col, pos); dx := e.W; h := e.H;
  123.         PrintPrepElem(E, e, fnt, col, -1, pos); dx := Max(dx, e.W); h := Max(h, e.H); w := dx
  124.     END GetElem;
  125.     PROCEDURE Parse (E: Elem): LONGINT;
  126.         CONST StrClass = {Texts.Name, Texts.String};
  127.         VAR S: Texts.Scanner; row: Row; pbeg, beg, pos: LONGINT; state, st, r, c: INTEGER; ch, period: CHAR;
  128.             margL, margR, margB, margT, gridW, lsp, dsr, min, max, cmin, cmax, cw, wl, wr, dx, x, y, w, h: LONGINT;
  129.             cm: ARRAY MaxCol OF CHAR;
  130.             rm: ARRAY MaxRow OF CHAR;
  131.             h1, h2, w1, w2: ARRAY MaxRow, MaxCol OF LONGINT;
  132.         PROCEDURE Setup;
  133.         BEGIN E.opts := {headRow, headCol, colL, rowL, leftL, rightL, topL, botL}; E.lw := 2*Scale; period := ".";
  134.             r := 0; WHILE r < MaxRow DO rm[r] := "L"; INC(r) END;
  135.             cm[0] := "L"; c := 1; WHILE c < MaxCol DO cm[c] := "N"; INC(c) END;
  136.             margL := 1*mm; margR := margL; margB := 3*Scale; margT := margB; gridW := 5*mm
  137.         END Setup;
  138.         PROCEDURE Scan (VAR S: Texts.Scanner);
  139.             VAR i: SHORTINT; ch: CHAR;
  140.         BEGIN ch := S.nextCh; i := 0;
  141.             LOOP
  142.                 IF ch = CR THEN INC(S.line)
  143.                 ELSIF (ch # " ") & (ch # TAB) THEN EXIT
  144.                 END;
  145.                 Texts.Read(S, ch)
  146.             END;
  147.             IF ("A" <= CAP(ch)) & (CAP(ch) <= "Z") THEN
  148.                 REPEAT S.s[i] := ch; INC(i); Texts.Read(S, ch)
  149.                 UNTIL (CAP(ch) > "Z")
  150.                     OR ("A" > CAP(ch)) & (ch > "9")
  151.                     OR ("0" > ch) & (ch # ".")
  152.                     OR (i = LEN(S.s)-1);
  153.                 S.s[i] := 0X; S.len := i; S.class := Texts.Name; S.nextCh := ch
  154.             ELSIF ch = "/" THEN S.class := 6; S.c := ch; Texts.Read(S, S.nextCh)
  155.             ELSE S.nextCh := ch; Texts.Scan(S)
  156.             END
  157.         END Scan;
  158.         PROCEDURE Options;
  159.         BEGIN Texts.OpenScanner(S, E.def, 0); Scan(S);
  160.             LOOP
  161.                 IF S.eot THEN RETURN
  162.                 ELSIF (S.class = Texts.Char) & (S.c = "/") THEN Scan(S);
  163.                     IF Matches(S, "TABLE") THEN RETURN
  164.                     ELSIF Matches(S, "BOTTOM") THEN Scan(S);
  165.                         IF (S.class = Texts.Int) & (0 <= S.i) & (S.i <= 100) THEN margB := S.i*Scale END
  166.                     ELSIF Matches(S, "COLUMNS") THEN Scan(S);
  167.                         IF S.class IN StrClass THEN ColOpts(cm, S.s) END
  168.                     ELSIF Matches(S, "GRID") THEN Scan(S);
  169.                         IF (S.class = Texts.Int) & (0 <= S.i) & (S.i <= 100) THEN gridW := S.i*Scale END
  170.                     ELSIF Matches(S, "HEADS") THEN Scan(S);
  171.                         IF S.class IN StrClass THEN E.opts := E.opts + Opts(S.s) END
  172.                     ELSIF Matches(S, "LEFT") THEN Scan(S);
  173.                         IF (S.class = Texts.Int) & (0 <= S.i) & (S.i <= 100) THEN margL := S.i*Scale END
  174.                     ELSIF Matches(S, "LINES") THEN Scan(S);
  175.                         IF S.class IN StrClass THEN E.opts := E.opts + LineOpts(S.s) END
  176.                     ELSIF Matches(S, "NOHEADS") THEN Scan(S);
  177.                         IF S.class IN StrClass THEN E.opts := E.opts - Opts(S.s) END
  178.                     ELSIF Matches(S, "NOLINES") THEN Scan(S);
  179.                         IF S.class IN StrClass THEN E.opts := E.opts - LineOpts(S.s) END
  180.                     ELSIF Matches(S, "PERIOD") THEN Scan(S);
  181.                         IF S.class IN StrClass THEN period := S.s[0] END
  182.                     ELSIF Matches(S, "RIGHT") THEN Scan(S);
  183.                         IF (S.class = Texts.Int) & (0 <= S.i) & (S.i <= 100) THEN margR := S.i*Scale END
  184.                     ELSIF Matches(S, "ROWS") THEN Scan(S);
  185.                         IF S.class IN StrClass THEN RowOpts(rm, S.s) END
  186.                     ELSIF Matches(S, "TOP") THEN Scan(S);
  187.                         IF (S.class = Texts.Int) & (0 <= S.i) & (S.i <= 100) THEN margT := S.i*Scale END
  188.                     ELSIF Matches(S, "WIDTHS") THEN Scan(S);
  189.                         IF (S.class = Texts.Int) & (1 <= S.i) & (S.i <= 10) THEN E.lw := S.i*Scale END
  190.                     END;
  191.                     Scan(S)
  192.                 ELSE Scan(S)
  193.                 END
  194.             END
  195.         END Options;
  196.         PROCEDURE AcceptCell;
  197.         BEGIN row.pos[c] := pos; w1[r, c] := cw; h1[r, c] := cmax - cmin; h2[r, c] := -cmin;
  198.             min := Min(min, cmin); max := Max(max, cmax);
  199.             CASE state OF
  200.                 0, 1: w2[r, c] := cw
  201.             |  2: w2[r, c] := wl
  202.             |  3: w2[r, c] := -1
  203.             END;
  204.             pos := Texts.Pos(S); INC(c); cmin := -E.parc.dsr; cmax := 0; cw := 0; state := 0;
  205.             IF c > E.nofCols THEN
  206.                 IF c < MaxCol THEN INC(E.nofCols) ELSE DEC(c) END
  207.             END
  208.         END AcceptCell;
  209.     BEGIN Setup; Options; INC(margL, E.lw); INC(margR, E.lw); INC(margB, E.lw); INC(margT, E.lw);
  210.         E.nofCols := 0; E.nofRows := 0;
  211.         ch := S.nextCh; WHILE ~S.eot & (ch # CR) DO Texts.Read(S, ch) END;
  212.         beg := Texts.Pos(S); TextFrames.ParcBefore(E.def, beg, E.parc, pbeg);
  213.     (*parse*)
  214.         pos := beg; E.row := NIL;
  215.         IF ~S.eot THEN NEW(row); r := 0; min := 0; max := 0; c := 0; cmin := -E.parc.dsr; cmax := 0; cw := 0; state := 0;
  216.             LOOP Texts.Read(S, ch);
  217.                 IF S.eot THEN EXIT
  218.                 ELSIF ch = CR THEN AcceptCell;
  219.                     IF TextFrames.gridAdj IN E.parc.opts THEN dsr := E.parc.dsr;
  220.                         WHILE dsr < -min DO INC(dsr, E.parc.lsp) END;
  221.                         lsp := Max(E.parc.lsp, dsr + max); INC(lsp, (-lsp) MOD E.parc.lsp)
  222.                     ELSE dsr := Max(E.parc.dsr, -min); lsp := Max(E.parc.lsp, dsr + max)
  223.                     END;
  224.                     row.dsr := dsr + margB; row.lsp := lsp + margB + margT;
  225.                     WHILE c < MaxCol DO
  226.                         row.pos[c] := E.def.len; h1[r, c] := 0; h2[r, c] := 0; w1[r, c] := 0; w2[r, c] := -1; INC(c)
  227.                     END;
  228.                     row.next := E.row; E.row := row; INC(r); IF r = MaxRow THEN EXIT END;
  229.                     NEW(row); min := 0; max := 0; c := 0
  230.                 ELSIF ch = TAB THEN AcceptCell
  231.                 ELSE st := state;
  232.                     IF (state < 2) & (ch = period) THEN wl := cw; state := 2
  233.                     ELSIF (state = 0) & ((ch >= "0") & (ch <= "9") OR (ch = "+") OR (ch = "-") OR (ch = "#")) THEN state := 1
  234.                     ELSIF state = 0 THEN state := 3
  235.                     END;
  236.                     IF (st # 0) OR (ch # "#") & (ch # "&") THEN
  237.                         IF (S.elem # NIL) & ~(S.elem IS TextFrames.Parc) THEN
  238.                             GetElem(E, S.elem, S.fnt, S.col, Texts.Pos(S)-1, dx, x, y, w, h)
  239.                         ELSE TextPrinter.Get(TextPrinter.FontNo(S.fnt), ch, dx, x, y, w, h)
  240.                         END;
  241.                         INC(y, Offset(S)); cmin := Min(cmin, y); cmax := Max(cmax, y + h); INC(cw, dx)
  242.                     END
  243.                 END
  244.             END;
  245.             E.nofRows := r
  246.         END;
  247.     (*format*)
  248.         IF E.nofRows < 2 THEN EXCL(E.opts, headRow) END;
  249.         IF E.nofCols < 2 THEN EXCL(E.opts, headCol) END;
  250.         c := 0;
  251.         WHILE c < E.nofCols DO
  252.             IF cm[c] = "N" THEN wl := 0; wr := 0; r := 0;
  253.                 WHILE r < E.nofRows DO
  254.                     IF w2[r, c] > wl THEN wl := w2[r, c] END;
  255.                     IF (w2[r, c] >= 0) & (w1[r, c] - w2[r, c] > wr) THEN wr := w1[r, c] - w2[r, c] END;
  256.                     INC(r)
  257.                 END;
  258.                 cw := wl + wr
  259.             ELSE cw := 0
  260.             END;
  261.             r := 0;
  262.             WHILE r < E.nofRows DO
  263.                 IF w1[r, c] > cw THEN cw := w1[r, c] END;
  264.                 INC(r)
  265.             END;
  266.             INC(cw, margL + margR);
  267.             IF gridW > 0 THEN INC(cw, (-cw) MOD gridW) END;
  268.             r := E.nofRows; row := E.row;
  269.             WHILE r > 0 DO DEC(r);
  270.                 IF cm[c] = "L" THEN row.x[c] := margL
  271.                 ELSIF cm[c] = "R" THEN row.x[c] := cw - margR - w1[r, c]
  272.                 ELSIF (cm[c] = "C") OR (w2[r, c] = -1) THEN row.x[c] := (cw - w1[r, c]) DIV 2
  273.                 ELSIF cm[c] = "N" THEN row.x[c] := (cw - wl - wr) DIV 2 + wl - w2[r, c]
  274.                 END;
  275.                 IF rm[r] = "B" THEN row.y[c] := margB + h2[r, c]
  276.                 ELSIF rm[r] = "T" THEN row.y[c] := row.lsp - h1[r, c] - margB + h2[r, c]
  277.                 ELSIF rm[r] = "C" THEN row.y[c] := (row.lsp - h1[r, c]) DIV 2 + h2[r, c]
  278.                 ELSIF rm[r] = "L" THEN row.y[c] := row.dsr
  279.                 END;
  280.                 row := row.next
  281.             END;
  282.             E.width[c] := cw;
  283.             INC(c)
  284.         END;
  285.         RETURN beg
  286.     END Parse;
  287.     (* operations on elements *)
  288.     PROCEDURE CopyText* (T: Texts.Text): Texts.Text;
  289.         VAR B: Texts.Buffer; t: Texts.Text;
  290.     BEGIN NEW(B); Texts.OpenBuf(B); Texts.Save(T, 0, T.len, B);
  291.         NEW(t); Texts.Open(t, ""); t.notify := T.notify;
  292.         Texts.Append(t, B); RETURN t
  293.     END CopyText;
  294.     PROCEDURE Open* (E: Elem; def: Texts.Text);
  295.         VAR row: Row; beg: LONGINT; i: INTEGER;
  296.     BEGIN
  297.         E.def := def; beg := Parse(E);
  298.         E.W := 0; i := 0; WHILE i < E.nofCols DO INC(E.W, E.width[i]); INC(i) END;
  299.         E.H := 0; row := E.row; WHILE row # NIL DO INC(E.H, row.lsp); row := row.next END;
  300.         IF (headRow IN E.opts) & (rowL IN E.opts) THEN INC(E.H, E.lw * 2) END;
  301.         IF (headCol IN E.opts) & (colL IN E.opts) THEN INC(E.W, E.lw * 2) END;
  302.         IF E.W < MinW THEN E.W := MinW END;
  303.         IF E.H < MinH THEN E.H := MinH END
  304.     END Open;
  305.     PROCEDURE Load* (E: Elem; VAR r: Files.Rider);
  306.         VAR text: Texts.Text; f: Files.File; pos, len: LONGINT; version, tag: CHAR;
  307.     BEGIN Files.Read(r, version); NEW(text); Texts.Load(r, text); text.notify := TextFrames.NotifyDisplay;
  308.         Open(E, text)
  309.     END Load;
  310.     PROCEDURE Store* (E: Elem; VAR r: Files.Rider);
  311.         VAR f: Files.File; pos, len: LONGINT;
  312.     BEGIN Files.Write(r, 1X); Texts.Store(r, E.def)
  313.     END Store;
  314.     PROCEDURE Changed* (E: Elem);
  315.         VAR R: Texts.Reader; T: Texts.Text;
  316.     BEGIN T := Texts.ElemBase(E);
  317.         IF T # NIL THEN Texts.OpenReader(R, T, 0);
  318.             REPEAT Texts.ReadElem(R) UNTIL R.elem = E;
  319.             T.notify(T, Texts.replace, Texts.Pos(R)-1, Texts.Pos(R))
  320.         END
  321.     END Changed;
  322.     PROCEDURE Line (x, y, w, h: INTEGER);
  323.     BEGIN Display.ReplConst(Display.white, x, y, w, h, Display.replace)
  324.     END Line;
  325.     PROCEDURE DrawString (E: Elem; F: Display.Frame; pos: LONGINT; x0, y0: INTEGER);
  326.         VAR R: Texts.Reader; e: Texts.Elem; pat: Display.Pattern;
  327.             px, pdx: LONGINT; dx, x, y, w, h: INTEGER; ch: CHAR;
  328.             disp: TextFrames.DisplayMsg;
  329.     BEGIN Texts.OpenReader(R, E.def, pos); Texts.Read(R, ch); px := LONG(x0) * unit;
  330.         IF (ch = "#") OR (ch = "&") THEN Texts.Read(R, ch) END;
  331.         WHILE ~R.eot & (ch # TAB) & (ch # CR) DO
  332.             IF R.elem # NIL THEN
  333.                 IF R.elem IS TextFrames.Parc THEN pdx := 0
  334.                 ELSE e := R.elem;
  335.                     DispPrepElem(E, e, R.fnt, R.col, Texts.Pos(R)-1); pdx := e.W;
  336.                     disp.prepare := FALSE; disp.fnt := R.fnt; disp.col := R.col; disp.pos := Texts.Pos(R)-1; disp.frame := F;
  337.                     disp.X0 := SHORT(px DIV unit); disp.Y0 := y0 + SHORT((Offset(R) - E.parc.dsr) DIV unit);
  338.                     disp.indent := 0;
  339.                     e.handle(e, disp)
  340.                 END
  341.             ELSE TextPrinter.GetChar(TextPrinter.FontNo(R.fnt), unit, ch, pdx, dx, x, y, w, h, pat);
  342.                 Display.CopyPattern(R.col, pat,
  343.                     SHORT(px DIV unit) + x, y0 + SHORT(Offset(R) DIV unit) + y, Display.replace)
  344.             END;
  345.             INC(px, pdx); Texts.Read(R, ch)
  346.         END
  347.     END DrawString;
  348.     PROCEDURE Draw* (E: Elem; F: Display.Frame; x0, y0: INTEGER);
  349.         VAR row: Row; r, c, x, y, w, h, h1, lw, d: INTEGER;
  350.         PROCEDURE Align(x: LONGINT): LONGINT;
  351.         BEGIN RETURN x + (-x) MOD unit
  352.         END Align;
  353.     BEGIN
  354.         IF (E.nofRows = 0) OR (E.nofCols = 0) THEN w := SHORT(E.W DIV unit); h := SHORT(E.H DIV unit);
  355.             Display.ReplPattern(Display.white, Display.grey1, x0, y0, w, h, Display.replace)
  356.         ELSE r := E.nofRows; row := E.row;
  357.             y := y0; lw := SHORT(Align(E.lw) DIV unit); d := SHORT(E.lw * 2 DIV unit);
  358.             WHILE r > 0 DO DEC(r); x := x0; c := 0; h := SHORT(row.lsp DIV unit); h1 := h;
  359.                 IF (r = 1) & (headRow IN E.opts) & (rowL IN E.opts) THEN INC(h1, d) END;
  360.                 WHILE c < E.nofCols DO w := SHORT(E.width[c] DIV unit);
  361.                     IF c = 0 THEN
  362.                         IF headCol IN E.opts THEN Line(x + w - lw, y, lw, h);
  363.                             IF colL IN E.opts THEN INC(w, d) END
  364.                         END;
  365.                         IF leftL IN E.opts THEN Line(x, y, lw, h1) END
  366.                     ELSIF colL IN E.opts THEN Line(x, y, lw, h)
  367.                     END;
  368.                     IF (c = E.nofCols - 1) & (rightL IN E.opts) THEN Line(x + w - lw, y, lw, h1) END;
  369.                     IF (r = 0) & (topL IN E.opts) OR (r = 1) & (headRow IN E.opts) THEN
  370.                         Line(x, y + h - lw, w, lw)
  371.                     END;
  372.                     IF (r = E.nofRows - 1) & (botL IN E.opts) OR (r < E.nofRows - 1) & (rowL IN E.opts) THEN
  373.                         Line(x, y, w, lw)
  374.                     END;
  375.                     DrawString(E, F, row.pos[c], x + SHORT(row.x[c] DIV unit), y + SHORT(row.y[c] DIV unit));
  376.                     INC(x, w); INC(c)
  377.                 END;
  378.                 INC(y, h1); row := row.next
  379.             END
  380.         END
  381.     END Draw;
  382.     PROCEDURE PrintString (E: Elem; pos: LONGINT; pno, x0, y0: INTEGER);
  383.         VAR R: Texts.Reader; e: Texts.Elem; fnt: Fonts.Font;
  384.             i, w, dy: INTEGER; voff, fno: SHORTINT; ch: CHAR; first: BOOLEAN;
  385.             print: TextPrinter.PrintMsg; s: ARRAY 256 OF CHAR;
  386.     BEGIN Texts.OpenReader(R, E.def, pos); Texts.Read(R, ch); first := TRUE;
  387.         IF (ch = "#") OR (ch = "&") THEN Texts.Read(R, ch) END;
  388.         WHILE ~R.eot & (ch # TAB) & (ch # CR) DO
  389.             WHILE ~R.eot & (R.elem # NIL) DO
  390.                 IF ~(R.elem IS TextFrames.Parc) THEN e := R.elem;
  391.                     PrintPrepElem(E, e, R.fnt, R.col, pno, Texts.Pos(R)-1);
  392.                     print.prepare := FALSE; print.indent := 0; print.fnt := R.fnt; print.col := R.col; print.pos := Texts.Pos(R)-1;
  393.                     print.X0 := x0; print.Y0 := y0 + SHORT((Offset(R) - E.parc.dsr) DIV Unit); print.pno := pno;
  394.                     e.handle(e, print); INC(x0, SHORT(e.W DIV Unit)); first := TRUE
  395.                 END;
  396.                 Texts.Read(R, ch)
  397.             END;
  398.             IF ~R.eot & (ch # TAB) & (ch # CR) THEN
  399.                 fnt := R.fnt; fno := TextPrinter.FontNo(fnt); voff := R.voff;
  400.                 dy := SHORT(Offset(R) DIV Unit); i := 0; w := 0;
  401.                 REPEAT s[i] := ch; INC(i); INC(w, SHORT(TextPrinter.DX(fno, ch) DIV Unit)); Texts.Read(R, ch)
  402.                 UNTIL R.eot OR (R.elem # NIL) OR (ch = TAB) OR (ch = CR)
  403.                         OR (fno # TextPrinter.FontNo(R.fnt)) OR (voff # R.voff) OR (i = LEN(s)-1);
  404.                 s[i] := 0X;
  405.                 IF voff # 0 THEN Printer.String(x0, y0 + dy, s, fnt.name); first := TRUE
  406.                 ELSIF first THEN Printer.String(x0, y0 + dy, s, fnt.name); first := FALSE
  407.                 ELSE Printer.ContString(s, fnt.name)
  408.                 END;
  409.                 INC(x0, w)
  410.             END
  411.         END
  412.     END PrintString;
  413.     PROCEDURE Print* (E: Elem; pno, x0, y0: INTEGER);
  414.         VAR row: Row; r, c, x, y, w, h, h1, lw, d: INTEGER;
  415.     BEGIN r := E.nofRows; row := E.row; y := y0; lw := SHORT(E.lw DIV Unit); d := SHORT(E.lw * 2 DIV Unit);
  416.         WHILE r > 0 DO DEC(r); x := x0; c := 0; h := SHORT(row.lsp DIV Unit); h1 := h;
  417.             IF (r = 1) & (headRow IN E.opts) & (rowL IN E.opts) THEN INC(h1, d) END;
  418.             WHILE c < E.nofCols DO w := SHORT(E.width[c] DIV Unit);
  419.                 IF c = 0 THEN
  420.                     IF headCol IN E.opts THEN Printer.ReplConst(x + w - lw, y, lw, h);
  421.                         IF colL IN E.opts THEN INC(w, d) END
  422.                     END;
  423.                     IF leftL IN E.opts THEN Printer.ReplConst(x, y, lw, h1) END
  424.                 ELSIF colL IN E.opts THEN Printer.ReplConst(x, y, lw, h)
  425.                 END;
  426.                 IF (c = E.nofCols - 1) & (rightL IN E.opts) THEN Printer.ReplConst(x + w - lw, y, lw, h1) END;
  427.                 IF (r = 0) & (topL IN E.opts) OR (r = 1) & (headRow IN E.opts) THEN
  428.                     Printer.ReplConst(x, y + h - lw, w, lw)
  429.                 END;
  430.                 IF (r = E.nofRows - 1) & (botL IN E.opts) OR (r < E.nofRows - 1) & (rowL IN E.opts) THEN
  431.                     Printer.ReplConst(x, y, w, lw)
  432.                 END;
  433.                 PrintString(E, row.pos[c], pno, x + SHORT(row.x[c] DIV Unit), y + SHORT(row.y[c] DIV Unit));
  434.                 INC(x, w); INC(c)
  435.             END;
  436.             INC(y, h1); row := row.next
  437.         END
  438.     END Print;
  439.     PROCEDURE OpenViewer* (E: Elem);
  440.         VAR V: Viewer; menu: TextFrames.Frame; body: TextFrames.Frame; x, y: INTEGER;
  441.             restore: Viewers.ViewerMsg;
  442.     BEGIN Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
  443.         menu := TextFrames.NewMenu("TableElems.Text",  Menu);
  444.         body := TextFrames.NewText(CopyText(E.def), 0);
  445.         NEW(V); V.handle := MenuViewers.Handle; V.dsc := menu; V.dsc.next := body;
  446.         V.menuH := TextFrames.menuH; V.elem := E;
  447.         Viewers.Open(V, x, y); restore.id := Viewers.restore; V.handle(V, restore)
  448.     END OpenViewer;
  449.     PROCEDURE Track* (E: Elem; pos: LONGINT; keys: SET; x, y, x0, y0: INTEGER);
  450.         VAR keysum: SET;
  451.     BEGIN
  452.         IF middleKey IN keys THEN keysum := keys;
  453.             REPEAT Input.Mouse(keys, x, y); Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, x, y);
  454.                 keysum := keysum + keys
  455.             UNTIL keys = {};
  456.             IF keysum = {middleKey} THEN OpenViewer(E) END
  457.         END
  458.     END Track;
  459.     (* handle elements *)
  460.     PROCEDURE Handle* (E: Texts.Elem; VAR msg: Texts.ElemMsg);
  461.         VAR e: Elem;
  462.     BEGIN
  463.         WITH E: Elem DO
  464.             WITH
  465.                 msg: TextFrames.DisplayMsg DO
  466.                     IF ~msg.prepare THEN Draw(E, msg.frame, msg.X0, msg.Y0) END
  467.             |  msg: TextPrinter.PrintMsg DO
  468.                     IF ~msg.prepare THEN Print(E, msg.pno, msg.X0, msg.Y0) END
  469.             |  msg: Texts.IdentifyMsg DO
  470.                     msg.mod := "TableElems"; msg.proc := "Alloc"
  471.             |  msg: Texts.FileMsg DO
  472.                     IF msg.id = Texts.load THEN Load(E, msg.r)
  473.                     ELSIF msg.id = Texts.store THEN Store(E, msg.r)
  474.                     END
  475.             |  msg: Texts.CopyMsg DO
  476.                     NEW(e); Texts.CopyElem(E, e); Open(e, CopyText(E.def)); msg(Texts.CopyMsg).e := e
  477.             |  msg: TextFrames.TrackMsg DO
  478.                     Track(E, msg.pos, msg.keys, msg.X, msg.Y, msg.X0, msg.Y0)
  479.             ELSE (*ignore*)
  480.             END
  481.         END
  482.     END Handle;
  483.     PROCEDURE Alloc*;
  484.         VAR e: Elem;
  485.     BEGIN NEW(e); e.handle := Handle; Texts.new := e
  486.     END Alloc;
  487.     (* commands *)
  488.     PROCEDURE Insert*;    (** ["^" | name] **)
  489.         VAR S: Texts.Scanner; text: Texts.Text; beg, end, time: LONGINT;
  490.             e: Elem; t: Texts.Text; m: TextFrames.InsertElemMsg;
  491.     BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
  492.         IF (S.class = Texts.Char) & (S.c = "^") THEN
  493.             Oberon.GetSelection(text, beg, end, time);
  494.             IF time >= 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END
  495.         END;
  496.         IF (S.class = Texts.Name) & (S.line = 0) THEN t := TextFrames.Text(S.s)
  497.         ELSE t := TextFrames.Text("");
  498.             Texts.WriteString(W, "/table"); Texts.WriteLn(W);
  499.             Texts.Append(t, W.buf)
  500.         END;
  501.         NEW(e); e.handle := Handle; Open(e, t); m.e := e;
  502.         Oberon.FocusViewer.handle(Oberon.FocusViewer, m)
  503.     END Insert;
  504.     PROCEDURE Update*;
  505.         VAR V: Viewer; F: TextFrames.Frame;
  506.     BEGIN V := Oberon.Par.vwr(Viewer); F := V.dsc.next(TextFrames.Frame);
  507.         Open(V.elem, CopyText(F.text)); Changed(V.elem); UnmarkMenu(V)
  508.     END Update;
  509. BEGIN Texts.OpenWriter(W)
  510. END TableElems.
  511.     Edit.Open ^    test.Txt        TableElems.Insert ^    testTable.Txt        System.Free TableElems ~
  512.